00100	ENTRY DOTDD,SHOWDD,CLRDD,ERASDD,STRDD,AIDD,AVDD;
00200	BEGIN	"TYPE31"
00300		REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
00400		INTERNAL SAFE INTEGER ARRAY DDBUF[1:480*18+2];
00500		INTEGER DDPTR,DDBIT;
00600	INTERNAL PROCEDURE CLRDD (INTEGER CHAN);
00700	BEGIN	"CLRDD"
00800		INTEGER LINE,LINEWD,COLCHN;
00900	α RESET GRAPHICS COMMAND WORDS TO ALL ZEROES;
01000		DDBUF[1]	←	2;
01100		ARRBLT(DDBUF[2],DDBUF[1],480*18);
01200	α RESET COLUMN,COLUMN,CHANNEL WORDS TO 1,1,0;
01300		COLCHN	←	'002004003324;
01400		DPB(CHAN,POINT(8,COLCHN,23));
01500		FOR DDPTR←2 STEP 18 UNTIL 2+18*479 DO
01600		DDBUF[DDPTR]	←	COLCHN;
01700	α RESET EXECUTE, LINE SELECT COMMAND WORDS;
01800		FOR LINE←0 STEP 1 UNTIL 479 DO
01900	BEGIN	"ROWS"
02000		LINEWD	←	'0454;
02100		DPB(LINE   ,POINT(4,LINEWD,23));
02200		DPB(LINE%16,POINT(5,LINEWD,15));
02300		DDPTR	←	((LINE LAND 3)*120 + LINE%4)*18 + 1;
02400		DDBUF[DDPTR]←	LINEWD;
02500	END	"ROWS";
02600	α RESET THE FIRST AND THE LAST TWO COMMAND WORDS;
02700		DDPTR	←	480*18;
02800		DDBUF[1]←	DDBUF[1] LOR '156000001454;
02900		DDBUF[DDPTR+1]←	'000004010334;
03000		DDBUF[DDPTR+2]←	0;
03100	END	"CLRDD";
     

00100	INTERNAL PROCEDURE DOTDD (INTEGER X,Y);
00200	BEGIN	"DOTDD"
00300		X	←	(0 MAX X) MIN 511;
00400		Y	←	(0 MAX Y) MIN 479;
00500		DDPTR	←	((Y LAND 3)*120 + (Y%4))*18 + (X%32) + 3;
00600		DDBIT	←	X LAND '37;
00700		DPB(1,POINT(1,DDBUF[DDPTR],DDBIT));
00800	END	"DOTDD";
00900	INTERNAL PROCEDURE SHOWDD;
01000	QUICK_CODE "SHOWDD"
01100		INTEGER T1,T2;
01200		MOVEI	11,8642;
01300		MOVEM	11,T2;
01400		MOVE	11,DDBUF;
01500		HRRZM	11,T1;
01600		'715000000000 3,T1;
01700	END	"SHOWDD";
     

00100	INTERNAL PROCEDURE LINEDD (INTEGER X1,Y1,X2,Y2);
00200	BEGIN	"LINEDD"
00300		REAL DX,DY,X,Y;
00400		INTEGER I,N;
00500		DX	←	X2-X1;
00600		DY	←	Y2-Y1;
00700		N	←	ABS(DX) MAX ABS(DY);
00800		DX	←	DX/N;
00900		DY	←	DY/N;
01000		DOTDD(X←X1,Y←Y1);
01100		FOR I←2 STEP 1 UNTIL N DO
01200		DOTDD(X←X+DX,Y←Y+DY);
01300		DOTDD(X2,Y2);
01400	END	"LINEDD";
01500		INTEGER BEAMX,BEAMY;
01600	INTERNAL PROCEDURE AIDD (INTEGER X,Y);
01700	BEGIN	"AIDD"
01800		BEAMX	←	X;
01900		BEAMY	←	Y;
02000	END	"AIDD";
02100	
02200	INTERNAL PROCEDURE AVDD (INTEGER X,Y);
02300	BEGIN	"AVDD"
02400		LINEDD(BEAMX,BEAMY,X,Y);
02500		BEAMX	←	X;
02600		BEAMY	←	Y;
02700	END	"AVDD";
     

00100	α ERASE THE DATA DISC'S SCREEN;
00500	INTERNAL PROCEDURE ERASDD (INTEGER CHAN);
00600	BEGIN
00700	INTEGER COLCHN,X1,X2,X3;
00800		COLCHN ← '136004301324;
00900		DPB(CHAN,POINT(8,COLCHN,23));
01000		X1←0;
01100	START_CODE "ERASDD"
01200		INTEGER T1,T2;
01300		LABEL L;
01400		MOVEI	11,COLCHN;
01500		MOVEM	11,T1;
01600		MOVEI	11,2;
01700		MOVEM	11,T2;
01800	L:	'715000000000 3,T1;
01900	END	"ERASDD";
02000	END;
     

00100	α DISPLAY A STRING ON CHANNEL 36;
00200	INTERNAL PROCEDURE STRDD (INTEGER X,Y; STRING STR);
00300	BEGIN	"STRDD"
00400		INTEGER SIZ,I;
00500		SIZ	←	LENGTH(STR);
00600		IF SIZ=0 THEN RETURN;
00700		SIZ	←	(IF SIZ MOD 5 THEN 1 ELSE 0) + SIZ%5;
00800	BEGIN	"DDBLK"
00900		INTEGER ARRAY DDBUF[-1:SIZ+2+10];
01000		INTEGER FNLINE,COLCHN;
01100	α ASSEMBLE THE FUNCTION AND LINE SELECT WORD;
01200		FNLINE	←	'1454;
01300		DPB('66,   POINT(6,FNLINE, 7));
01400		DPB(Y%16,  POINT(5,FNLINE,15));
01500		DPB(Y,     POINT(4,FNLINE,23));
01600		DDBUF[-1]←	FNLINE;
01700	α ASSEMBLE THE COLUMN AND CHANNEL SELECT WORD;
01800		COLCHN	←	'3324;
01900		DPB(1,     POINT(8,COLCHN, 7));
02000		DPB(X DIV 6,  POINT(8,COLCHN,15));
02100		DPB('35, POINT(8,COLCHN,23));
02200		DDBUF[0]←	COLCHN;
02300	α PACK THE STRING INTO TEXT COMMAND WORDS;
02400		FOR I←1 STEP 1 UNTIL SIZ-1 DO
02500	BEGIN	"PACK"
02600		DDBUF[I]←	CVASC(STR) LOR 1;
02700		STR	←	STR[6 TOO ∞];
02800	END	"PACK";
02900		DDBUF[SIZ]←	CVASC(STR) LOR 1;
03000		DDBUF[SIZ+1]←	'000004010034;
03100		DDBUF[SIZ+2]←	0;
03200	α DISPLAY DD BUFFER;
03300	QUICK_CODE
03400		INTEGER T1,T2;
03500		MOVE	11,SIZ;
03600		ADDI	11,4;
03700		MOVEM	11,T2;
03800		MOVE	11,DDBUF;
03900		HRRZM	11,T1;
04000		'715000000000 3,T1;
04100		HRRZ	11,@DDBUF;
04200		TRC	11,'010000;
04300		HRRM	11,@DDBUF;
04400		'715000000000 3,T1;
04500	END;
04600	END	"DDBLK";
04700	END	"STRDD";
04800	END	"TYPE31";